home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Controls
/
Visual Basic Controls.iso
/
vbcontrol
/
sgverinf
/
FINDVERI.VBS
< prev
next >
Wrap
Text File
|
1998-08-10
|
5KB
|
152 lines
'--------------------------------------------------------------------------
' FindVerInfo.vbs - Finds files which have specified string in the
' version information
'
' SYNTAX: FindVerInfo path verinfo_name value
'
' path - folder to be searched
' verinfo_name - name of the version item to search
' value - value to search for
'
'
' This file is part of the sgVersionInfo.
' Copyright (C) 1998 Stinga
' All rights reserved.
'
' This source code demonstrates usage of the sgVersionInfo component
'--------------------------------------------------------------------------
' sgFileFlag constants
const sgVS_FF_DEBUG = &H00000001
const sgVS_FF_PRERELEASE = &H00000002
const sgVS_FF_PATCHED = &H00000004
const sgVS_FF_PRIVATEBUILD = &H00000008
const sgVS_FF_INFOINFERRED = &H00000010
const sgVS_FF_SPECIALBUILD = &H00000020
' sgFileOS constants
const sgVOS_UNKNOWN = &H00000000
const sgVOS_DOS = &H00010000
const sgVOS_OS216 = &H00020000
const sgVOS_OS232 = &H00030000
const sgVOS_NT = &H00040000
const sgVOS__BASE = &H00000000
const sgVOS__WINDOWS16 = &H00000001
const sgVOS__PM16 = &H00000002
const sgVOS__PM32 = &H00000003
const sgVOS__WINDOWS32 = &H00000004
const sgVOS_DOS_WINDOWS16 = &H00010001
const sgVOS_DOS_WINDOWS32 = &H00010004
const sgVOS_OS216_PM16 = &H00020002
const sgVOS_OS232_PM32 = &H00030003
const sgVOS_NT_WINDOWS32 = &H00040004
' sgFileType constants
const sgVFT_UNKNOWN = &H00000000
const sgVFT_APP = &H00000001
const sgVFT_DLL = &H00000002
const sgVFT_DRV = &H00000003
const sgVFT_FONT = &H00000004
const sgVFT_VXD = &H00000005
const sgVFT_STATIC_LIB = &H00000007
' sgFileSubtype constants
const sgVFT2_UNKNOWN = &H00000000
const sgVFT2_DRV_PRINTER = &H00000001
const sgVFT2_DRV_KEYBOARD = &H00000002
const sgVFT2_DRV_LANGUAGE = &H00000003
const sgVFT2_DRV_DISPLAY = &H00000004
const sgVFT2_DRV_MOUSE = &H00000005
const sgVFT2_DRV_NETWORK = &H00000006
const sgVFT2_DRV_SYSTEM = &H00000007
const sgVFT2_DRV_INSTALLABLE = &H00000008
const sgVFT2_DRV_SOUND = &H00000009
const sgVFT2_DRV_COMM = &H0000000A
const sgVFT2_DRV_INPUTMETHOD = &H0000000B
const sgVFT2_FONT_RASTER = &H00000001
const sgVFT2_FONT_VECTOR = &H00000002
const sgVFT2_FONT_TRUETYPE = &H00000003
On Error Resume Next
Dim sKey, sValue, sFolder, sInfo, sMsg
Dim vbCrLf
vbCrLf = Chr(13) + Chr(10)
' Are we running from command line
Dim bFromCmdLine
bFromCmdLine = false
if InStrRev(UCase(WScript.FullName), "CSCRIPT") then bFromCmdLine = true
' Check arguments
if WScript.Arguments.Count <> 3 then
' Command line does not contain arguments.
' Retrieve arguments from the user
sFolder = InputBox("Enter folder to search:", "Folder")
if sFolder = "" then WScript.Quit(0)
sKey = InputBox("Enter key to search:", "Key", "CompanyName")
if sKey = "" then WScript.Quit(0)
sValue = InputBox("Enter value to search for:", "Value", "Stinga")
if sValue = "" then WScript.Quit(0)
else
sFolder = WScript.Arguments(0)
sKey = WScript.Arguments(1)
sValue = WScript.Arguments(2)
end if
' WScript.Echo "Invalid command line. Expected: " + vbCrLf + "FindVerInfo path verinfo_name value"
' WScript.Quit(0)
'end if
' Create some objects
set VerInfo = WScript.CreateObject("sgVersionInfo.VersionInfo")
Set fs = WScript.CreateObject("Scripting.FileSystemObject")
if (Err.Number <> 0) then
Msg "Error: Unable to create SGVersionInfo or FileSystemObject object", 0, "Find Version Info Error"
WScript.Quit(0)
end if
Set foldr = fs.GetFolder(sFolder)
' Scan all files in the folder
For Each file In foldr.Files
' Try to get version info for current file
VerInfo.Path = File.Path
if Err.Number = 0 then
' No error. Get specified info and see if specified value is in it
if VerInfo.InfoExist then
sInfo = VerInfo.GetValue("StringFileInfo", sKey)
if InStr(sInfo, sValue) > 0 then
sMsg = file.Name + Chr(9) + VerInfo.FileVersion + Chr(9) + VerInfo.FileDescription
rc = Msg(sMsg, 1, "Find Version Info")
if rc = 2 then WScript.Quit(0)
end if
end if
else
' Somethig went wrong
sMsg = "Error: " + file.Name + " - " + Err.Decription
Msg sMsg, 1, "Find Version Info Error"
Err.Clear
end if
next
set VerInfo = nothing
Set fs = nothing
Set foldr = nothing
WScript.Quit(0)
function Msg(sText, nFlags, sTitle)
Msg = 0
if bFromCmdLine then
WScript.Echo sText
else
if sTitle <> "" then
Msg = MsgBox(sText, nFlags, sTitle)
else
Msg = MsgBox(sText, nFlags)
end if
end if
end function